perm filename DRUM.F4[LK,LCS] blob sn#160177 filedate 1975-05-20 generic text, type T, neo UTF8
00100	C  SETS UP 6 RHYTHMIC LISTS WHICH CAN BE CHOSEN AT RANDOM.
00200	C LOAD THE LIST BY USING INST. '<DUMY'. EACH LIST MUST END WITH 2 NEGS.
00300		SUBROUTINE SUBR
00400		COMMON /INS/ INST(27),BG(60)
00500		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00600	C   INUM=INST#  IPAR=PARAM#  
00700	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00800	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
00900	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01000	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01100	C   F1=86  F15=100 (NO F16!)
01200		DIMENSION A(7,30)
01300		EQUIVALENCE (P2,P(2))
01400	
01500		IF(INST(INUM).NE.'<DUMY')GO TO 100
01600		XP=-1
01700		K=CNT(INUM)
01800		DO 40 J=1,7
01900	40	A(J,K)=P(J+2)
02000	C  P3 GOES INT A(1,   P4 → A(2,  ETC.
02100	C  STORES 7 RHYTH LISTS.
02200		RETURN
02300	
02400	100	IF(CNT(INUM).EQ.1)KK=0
02500		INST(INUM)='FM'
02600		IF(IPAR.NE.2)GO TO 20
02700	10	IF(KK.NE.0)GO TO 21
02800		J=P2
02900		RR=RAND(.7,1.2)
03000	C  RR IS SPEED FACTOR
03100		REV=RAND(.08,.9)
03200		FM=RAND(700.,900.)
03300		FMX=RAND(5.,6.)
03350		FREQ=RAND(-12.,15.)
03400	21	KK=KK+1
03500	22	P2=A(J,KK)*RR
03510		DF=A(J,KK+1)
03600	200	IF(P2.AND.DF)KK=0
03700		IF(KK.GE.30)KK=0
03800		DF=-.4
03850		IF(P2)IREST=-1
03900	C  SO NOTE WILL NEVER BE LONGER THAN .4"
04000		IF(XP.GE.P(1))RETURN
04100		IF(P2)RETURN
04200		X=RAND(-10.,20.)
04300		IF(X)DF=.4/P2
04350		Q=.4
04375		IF(X.GT.0)Q=Q*P2
04400		XP=P(1)+Q
04500	C  1/3 OF THE NOTES ARE LOW AND LONG
04600		RETURN
04800	20	IF(DF.EQ.-.4)GO TO 31
04900		P(3)=P(8)+X
05000	C  P8 WILL HAVE LOWNOTE FREQ.
05100		INST(INUM)='FM2'
05250	31	P(3)=P(3)+FREQ
05275		IF(RR.LT..9)P(3)=P(3)/RR
05280		P(8)=FM/P(3)
05300		P(9)=P(3)*FMX/8.
05350		IF(P(12))DF=P(12)
05375	C  USE P12 TO RESET DUTY FACT.
05390		P(12)=REV
05400		END